Enter 2001 April/EnterCD4.iso/Update/SQL Server SP3/sql70sp3i.exe/X86/BINN/res/1033/sqlmmc.rll/HTML/REPFUNCS.BAS

BASIC Source File | 1999-04-12 | 38.9 KB | 1,061 lines

Option Explicit
' **********************************************************
'  repFuncs.bas
'
'  Functions that work with the repository object
' **********************************************************

Const strIDbmDeployedCatalog = "{{7FCF7882-AF00-11d1-8C1E-00AA00A14D34},00002B7A}"
'Const strIDbmSchema = "{{391881E3-F894-11d0-8E76-00A0C905A4DB},0000138A}"
'Const strIDbmTable = "{{391881E3-F894-11d0-8E76-00A0C905A4DB},0000138D}"
'Const strIDbmDeployedColumn = "{{391881E3-F894-11d0-8E76-00A0C905A4DB},00001487}"
'Const strITfmTransformationPackage = "{{7FCF7882-AF00-11d1-8C1E-00AA00A14D34},00002B5B}"
Const strITfmPackageExecution = "{{7FCF7882-AF00-11d1-8C1E-00AA00A14D34},00002B65}"
Const strIDTSTransformationPackage = "{{EBB9995C-BA15-11d1-901B-0000F87A3B33},000032CA}"
Const strIDbmSchema = "{391881E6-F894-11d0-8E76-00A0C905A4DB}"
Const strIDbmTable = "{391881E8-F894-11d0-8E76-00A0C905A4DB}"
Const strIDbmDeployedColumn = "{38C13CA3-E9F4-11d1-B06D-0000F87A57EE}"
Const strITfmTransformationPackage = "{7FCF788E-AF00-11d1-8C1E-00AA00A14D34}"
Const strPropShortExecutionID = "{{7FCF7882-AF00-11d1-8C1E-00AA00A14D34},00002B67}"
Const strPropExecutionID = "{{7FCF7882-AF00-11d1-8C1E-00AA00A14D34},00002B66}"
Const iInitialArraySize = 25
Const iArrayIncrement = 25
' **********************************************************
'  findLinGuids
'
'  Finds an array of Lineage Guids given a LineageLong or
'  a LineageShort value
' **********************************************************
Sub findLinGuids(arrLinGuids, ByVal LineageLong, ByVal LineageShort)
      ReDim arrLinGuids(0)    ' in case of error or not found
      Dim strSQL
      Dim roTemp 'As RepositoryObject
      Dim iCnt
      Dim collLin
      Dim iSize
      Dim rReposODBC 'As IRepositoryODBC2
      Dim roPackageExecution
      Dim roShortExecutionID
      Dim roExecutionID
      Dim roPropExecutionID
      Dim roPropShortExecutionID
      Dim strStorageTable
      Dim strExecutionIDCol
      Dim strShortExecutionIDCol
      Dim rTempRepos

        ' get the appropriate table and column names from the TIM objects
          Set roPackageExecution = rRepos.object(strITfmPackageExecution)
          strStorageTable = roPackageExecution("IInterfaceDef").TableName
          Set roPackageExecution = Nothing
          Set roPropExecutionID = rRepos.object(strPropExecutionID)
          strExecutionIDCol = roPropExecutionID("IPropertyDef").ColumnName
          Set roPropExecutionID = Nothing
          Set roPropShortExecutionID = rRepos.object(strPropShortExecutionID)
          strShortExecutionIDCol = roPropShortExecutionID("IPropertyDef").ColumnName
          Set roPropShortExecutionID = Nothing

          Set rTempRepos = rRepos
          Set rReposODBC = objSQLNSContext.QueryInterfaceScriptObject(rTempRepos, "{8780D159-B879-11D1-98BA-00C04FC30B4A}")
          Set rTempRepos = Nothing

          strSQL = "SELECT RTblVersions.IntID from RTblVersions,  " & _
                  strStorageTable & _
                  " where RTblVersions.IntID = " & _
                  strStorageTable & ".IntID and "

          If (Trim(LineageLong) <> "") Then
            ' use the LineageLong
            strSQL = strSQL & strStorageTable & "." & strExecutionIDCol & _
            " = '" & LineageLong & "'"
          Else
            ' use the LineageShort
            strSQL = strSQL & strStorageTable & "." & strShortExecutionIDCol & _
                " = " & LineageShort
          End If

          'On Error Resume Next
          Set collLin = rReposODBC.ExecuteQuery(strSQL)
          iSize = 0
          iSize = collLin.Count
          On Error GoTo 0
          If iSize < 0 Then iSize = 0
          ReDim arrLinGuids(iSize)

          For iCnt = 0 To iSize - 1
            Set roTemp = collLin(iCnt + 1)
            arrLinGuids(iCnt) = GetOIDString(roTemp.VersionID)
            Set roTemp = Nothing
          Next

          Set collLin = Nothing

        Exit Sub

End Sub


' **********************************************************
'  getPackageGuidFromLin
'
'  Finds a Version GUID given a Lineage GUID.
' **********************************************************
Function getPackageGuidFromLin(ByVal strLinGuid)
    Dim roTemp

    Set roTemp = rRepos.Version(strLinGuid)
    On Error Resume Next 'ignore not found - though it is pretty bad
    getPackageGuidFromLin = GetOIDString(roTemp.Interface("ITfmPackageExecution").TransformationPackage(1).VersionID)
    On Error GoTo 0
    Set roTemp = Nothing

End Function


' **********************************************************
'  getPackageGuidFromVers
'
'  Finds a Package GUID given a Version GUID.
' **********************************************************
Function getPackageGuidFromVers(ByVal strVerGuid)
    'Dim roTemp

    'Set roTemp = rRepos.Version(strVerGuid)
    'getPackageGuidFromVers = GetOIDString(roTemp.ObjectVersions(1))
    'Set roTemp = Nothing

    getPackageGuidFromVers = strVerGuid

End Function
' **********************************************************
'  getPackageGuids
'
'  finds all the packages in the repository
' **********************************************************
Function getPackageGuids(arrPacks)
   ReDim arrPacks(0) ' in case of error or not found
      Dim roITransformationPackage

      'get the object that represents ITransformationPackage in the repository
      Set roITransformationPackage = rRepos.object(strIDTSTransformationPackage)

      AddObjInstToArray arrPacks, roITransformationPackage, 0, False

      Set roITransformationPackage = Nothing

End Function


' **********************************************************
'  getPackageNameDesc
'
'  Finds Package Name and Description given its GUID
' **********************************************************
Sub getPackageNameDesc(strName, strDesc, ByVal strGuid)
        GetNameDescription strName, strDesc, strGuid
End Sub

' **********************************************************
'  getPackageProperties
'
'  Gets the propery values of a version given its GUID
' **********************************************************
Sub getPackageProperties(arrPackPropValues, ByVal strPackageGUID)
      ReDim arrPackPropValues(13)     ' blank values in case of error or not found

      Dim roPackageVer 'As RepositoryObject
      Dim roPackage 'As RepositoryObject
      Dim roTemp 'As RepositoryObjectVersion

        'This will get us the latest (according to the repository rules) version of the package in the repository
        Set roPackageVer = rRepos.Version(strPackageGUID)

        'Now we need to get the first version, to show the original package create time

        Set roPackage = roPackageVer.ObjectVersions(1)


        arrPackPropValues(0) = roPackageVer.Name            'Name
        arrPackPropValues(1) = roPackageVer("IUmlElement").TaggedValues("PackageVersionID").Interface("IUmlTaggedValue").Value 'Version
        arrPackPropValues(2) = roPackageVer("ISummaryInformation").ShortDescription        'Description
        arrPackPropValues(3) = roPackageVer("ISummaryInformation").Comments    'Comments
        arrPackPropValues(4) = roPackageVer("IGenSummaryInformation").Author   'Author
        arrPackPropValues(5) = roPackageVer("IGenSummaryInformation").OwnerInformation       'Author Information
        arrPackPropValues(6) = roPackageVer("IVersionAdminInfo").CreateByUser  'Create By User
        arrPackPropValues(7) = roPackageVer("IVersionAdminInfo").ModifyByUser  'Modified By User
        arrPackPropValues(8) = roPackageVer("IVersionAdminInfo").VersionCreateTime 'Version Create Time
        arrPackPropValues(9) = roPackageVer("IVersionAdminInfo").VersionModifyTime  'Version Modified Time
        arrPackPropValues(10) = roPackage("IVersionAdminInfo").VersionCreateTime 'Package Creation Date
        arrPackPropValues(11) = roPackageVer("IDtsTransformationPackage").PackageID  'PackageVerID
        arrPackPropValues(12) = roPackageVer("IDtsTransformationPackage").ExceptionLog  'Exception Log
        arrPackPropValues(13) = roPackageVer.IsFrozen

        Set roPackage = Nothing
        Set roTemp = Nothing
        Set roPackageVer = Nothing
End Sub


' **********************************************************
'  getPackageVermodtime
'
'  Gets the propery value VersionModifyTime of a version given its GUID
' **********************************************************
Sub getPackageVermodtime(strVermodtime, ByVal strPackageGUID)
    Dim roPackageVer 'As RepositoryObject

    'This will get us the latest (according to the repository rules) version of the package in the repository
    Set roPackageVer = rRepos.Version(strPackageGUID)

    'strVermodtime = roPackageVer("IVersionAdminInfo").VersionModifyTime  'Version Modified Time
     ' 10/14/98 decided to use create time due to times appearing funny because of the way the dates are set by the
     '   package save
    strVermodtime = roPackageVer("IVersionAdminInfo").VersionCreateTime  'Version Created Time


    Set roPackageVer = Nothing
End Sub


' **********************************************************
'  getLinProperties
'
'  Gets the propery values of a Lineage given its GUID
' **********************************************************
Sub getLinProperties(arrLinPropValues, ByVal strLinGuid)
        ReDim arrLinPropValues(5)       ' blank values in case of error or not found

        Dim roTemp

        Set roTemp = rRepos.Version(strLinGuid)

        arrLinPropValues(0) = roTemp.Name  'Name
        arrLinPropValues(1) = roTemp("ITfmPackageExecution").ExecutionID       'Lineage Long
        arrLinPropValues(2) = roTemp("ITfmPackageExecution").ShortExecutionID  'Lineage Short
        arrLinPropValues(3) = roTemp("ITfmPackageExecution").System             'System
        arrLinPropValues(4) = roTemp("ITfmPackageExecution").Account             'Account
        arrLinPropValues(5) = roTemp("ITfmPackageExecution").WhenExecuted      'Execution Time

        Set roTemp = Nothing

End Sub


' **********************************************************
'  getVersionName
'
'  Gets the name of the version given its GUID
' **********************************************************
Sub getVersionName(strVersionName, ByVal strVersionGuid)
    Dim roTemp

    Set roTemp = rRepos.Version(strVersionGuid)
    'On Error Resume Next
    strVersionName = roTemp.Name
    On Error GoTo 0
    Set roTemp = Nothing

End Sub


' **********************************************************
'  getLinName
'
'  Gets the name of the lineage given its GUID
' **********************************************************
Sub getLinName(strLineageName, ByVal strLinGuid)
    Dim roTemp

    Set roTemp = rRepos.Version(strLinGuid)
    'On Error Resume Next
    strLineageName = roTemp.Name
    On Error GoTo 0
    Set roTemp = Nothing

End Sub

' **********************************************************
'  findVersionGuids
'
'  Finds all the other Versions given a version GUID
' **********************************************************
Sub findVersionGuids(arrVersions, ByVal strPackageGUID)
      ReDim arrVersions(0)    ' in case of error or not found
      Dim roTemp
      Dim roVersion
      Dim iCnt

      Set roTemp = rRepos.Version(strPackageGUID)
      iCnt = roTemp.ObjectVersions.Count
      If iCnt < 0 Then iCnt = 0
      ReDim arrVersions(iCnt)
      iCnt = 0
      For Each roVersion In roTemp.ObjectVersions
        arrVersions(iCnt) = GetOIDString(roVersion.VersionID)
        Set roVersion = Nothing
        iCnt = iCnt + 1
      Next
      Set roTemp = Nothing

End Sub


' **********************************************************
'  findLineageGuids
'
'  Finds all the Lineages given a version GUID
' **********************************************************
Sub findLineageGuids(arrLineages, ByVal strVersionGuid)
      ReDim arrLineages(0)    ' in case of error or not found
      Dim roTemp
      Dim roLineage
      Dim iCnt

      Set roTemp = rRepos.Version(strVersionGuid)
      iCnt = roTemp("ITfmTransformationPackage").Executions.Count
      If iCnt < 0 Then iCnt = 0
      ReDim arrLineages(iCnt)

      iCnt = 0
      For Each roLineage In roTemp("ITfmTransformationPackage").Executions
        arrLineages(iCnt) = GetOIDString(roLineage.VersionID)
        Set roLineage = Nothing
        iCnt = iCnt + 1
      Next

      Set roTemp = Nothing


End Sub
' **********************************************************
'  findDbGuids
'
'  Finds all the Database GUIDS
' **********************************************************
Sub findDbGuids(arrDbs)
      ReDim arrDbs(0) ' in case of error or not found
      Dim roIDbmDeployedCatalog

      'get the object that represents IDbmDeployedCatalog in the repository
      Set roIDbmDeployedCatalog = rRepos.object(strIDbmDeployedCatalog)

      AddObjInstToArray arrDbs, roIDbmDeployedCatalog, 0, True

      Set roIDbmDeployedCatalog = Nothing

End Sub


' **********************************************************
'  GetDBDataSource
'
' **********************************************************
Function GetDBDataSource(ByVal strGuid, strDBMSName, strDBMSVersion)
    Dim roObj
    Dim roPackage
    Dim roDBMSSource


    'Jason - this has been updated and it works

    Set roObj = rrepos.Version(strGuid)
    GetDBDataSource = ""
    On Error Resume Next
    set roPackage = roObj("IUmlElement").Package(1)
    GetDBDataSource = roPackage.Name
    set roDBMSSource  = roPackage.Interface("IDbmDataSource").DBMS(1)
    strDBMSName = roDBMSSource.Name
    strDBMSVersion = roDBMSSource.Interface("IDbmDBMSNamespace").Version
    set roDBMSSource = Nothing
    set roPackage = Nothing
    On Error GoTo 0

    Set roObj = Nothing
End Function



Sub AddObjInstToArray(arrIn, roInterface, iSizeIn, ByVal bDatabase)
      Dim roCatalog
      Dim roDescendantInterface
      Dim iArraySize
      Dim iCnt
      Dim bIsPublic
      Dim iNumAdded

      'here we have to get the count and then interate throught the collection explicitly.
      ' if we just do a for each on the ObjectInstances, we get IRepositoryDispatch objects back,
      ' and we can't get from there to the VersionID

      'we are currently letting the repository determine the latest version for each object to
      ' return to us. We could also iterate through all versions of each object returned to
      ' get all versions of the databases. If we do this we would need to update the display to
      ' add another level to the hierarchy to show the versions of the database.

      iArraySize = roInterface("IInterfaceDef").ObjectInstances.Count
      ReDim Preserve arrIn(iArraySize + iSizeIn)
      iNumAdded = 0
      For iCnt = 1 To iArraySize
        Set roCatalog = roInterface("IInterfaceDef").ObjectInstances(iCnt)
        If bDatabase Then
          'we need to check the data source for the catalog to see if it was
          ' loaded as a local DTS catalog. If it was, we ignore it. The local
          ' DTS catalogs do not have complete metadata, and would be confusing
          ' to users.
          On Error Resume Next
          bIsPublic = roCatalog("IUmlElement").package(1).Interface("IDbmDataSource").IsPublic
          On Error GoTo 0
        End If
        If bIsPublic Or Not bDatabase Then
          iNumAdded = iNumAdded + 1
          arrIn(iNumAdded + iSizeIn - 1) = GetOIDString(roCatalog.VersionID)
        End If
        Set roCatalog = Nothing
      Next
      'resize the array to the actual number of items
      If iNumAdded <> iArraySize Then ReDim Preserve arrIn(iNumAdded + iSizeIn)

      'there is currently a bug in the repository engine where descendant interfaces aren't included when you do
      ' ObjectInstances. We will explicitly iterate through each one. Note that this is a recursive function
      ' in order to follow the inheritance chain all the way down.
      For Each roDescendantInterface In roInterface("IInterfaceDef").Descendants
        AddObjInstToArray arrIn, roDescendantInterface, iNumAdded + iSizeIn, bDatabase
        Set roDescendantInterface = Nothing
      Next


End Sub


' **********************************************************
'  getDbNameDesc
'
'  Finds Database Name and Description given its GUID
' **********************************************************
Sub getDbNameDesc(strDbName, strDbDesc, ByVal strDbGuid)

    GetNameDescription strDbName, strDbDesc, strDbGuid

End Sub



Sub GetNameDescription(strName, strDesc, ByVal strGuid)
    Dim roObj

    Set roObj = rRepos.Version(strGuid)

    strName = roObj.Name
    strDesc = roObj("ISummaryInformation").ShortDescription

    Set roObj = Nothing
End Sub

' **********************************************************
'  findSchemaGuids
'
'  Finds all the Schema GUIDS given a database GUID
' **********************************************************
Sub findSchemaGuids(arrItems, strGuid)
    ReDim arrItems(0)       ' in case of error or not found
    Dim roDb
    Dim roSchema
    Dim iCnt

    Set roDb = rRepos.Version(strGuid)
    iCnt = 0
    For Each roSchema In roDb("IUmlPackage").Elements
      If VerifyInterfaceSupport(roSchema, strIDbmSchema) Then
        iCnt = iCnt + 1
        CheckArraySize arrItems, iCnt
        arrItems(iCnt - 1) = GetOIDString(roSchema.VersionID)
      End If
      Set roSchema = Nothing
    Next
    ReDim Preserve arrItems(iCnt)
    Set roDb = Nothing

End Sub

' **********************************************************
'  checkarraysize
'
'  verifies the array is big enough, and makes it bigger if not
'   uses the intialsize and increment constants to resize
' **********************************************************

Sub CheckArraySize(arrIn, iItems)

    If iItems > UBound(arrIn, 1) Then
      If UBound(arrIn, 1) = 0 Then
        ReDim arrIn(iInitialArraySize)
      Else
        ReDim Preserve arrIn(iItems + iArrayIncrement)
      End If
    End If

End Sub

' **********************************************************
'  VerifyInterfaceSupport
'
'  for some of the collections we iterate through, we can get
'   things of different types. We have to check each object to make
'   sure it supports the interface we need.
' **********************************************************

Function VerifyInterfaceSupport(roObject, strInterfaceGUID)

  Dim roInterfaceObj

        on error resume next
    VerifyInterfaceSupport = True
    Set roInterfaceObj = objSQLNSContext.QueryInterfaceScriptObject(roObject, strInterfaceGUID)
    if err.number > 0 then
            VerifyInterfaceSupport = False
        end if

    'For Each roInterfaceObj In rRepos.object(roObject.Type)("IClassDef").Interfaces
    '  If InterfaceObjectSupportsInterface(roInterfaceObj, strInterfaceGUID) Then
    '    VerifyInterfaceSupport = True
    '    Set roInterfaceObj = Nothing
    '    Exit For
    '  End If
    '  Set roInterfaceObj = Nothing
    'Next

End Function



Function InterfaceObjectSupportsInterface(roInterfaceObj, strInterfaceGUID)

  Dim roAncestorInterface
  Dim strGuid

    InterfaceObjectSupportsInterface = False
    If UCase(GetOIDString(roInterfaceObj.ObjectID)) = UCase(strInterfaceGUID) Then
      InterfaceObjectSupportsInterface = True
    Else
      On Error Resume Next
      Set roAncestorInterface = roInterfaceObj("IInterfaceDef").Ancestor(1)

      strGuid = ""
      strGuid = GetOIDString(roAncestorInterface.ObjectID)
      If UCase(strGuid) = UCase(strInterfaceGUID) Then
        InterfaceObjectSupportsInterface = True
      Else
        InterfaceObjectSupportsInterface = InterfaceObjectSupportsInterface(roAncestorInterface, strInterfaceGUID)
      End If
      On Error GoTo 0
      Set roAncestorInterface = Nothing
    End If

End Function

' **********************************************************
'  getSchemaNameDesc
'
'  Finds Schema Name and Description given its GUID
' **********************************************************
Sub getSchemaNameDesc(strName, strDesc, ByVal strGuid)
    GetNameDescription strName, strDesc, strGuid
End Sub


' **********************************************************
'  findTableGuids
'
'  Finds all the Table GUIDS given a schema GUID
' **********************************************************
Sub findTableGuids(arrItems, strGuid)
    ReDim arrItems(0)       ' in case of error or not found

    Dim roSchema
    Dim roTable
    Dim iCnt

    Set roSchema = rRepos.Version(strGuid)
    iCnt = 0
    For Each roTable In roSchema("IUmlPackage").Elements
      If VerifyInterfaceSupport(roTable, strIDbmTable) Then
        iCnt = iCnt + 1
        CheckArraySize arrItems, iCnt
        arrItems(iCnt - 1) = GetOIDString(roTable.VersionID)
      End If
      Set roTable = Nothing
    Next
    ReDim Preserve arrItems(iCnt)
    Set roSchema = Nothing
End Sub


' **********************************************************
'  getTableNameDesc
'
'  Finds Table Name and Description given its GUID
' **********************************************************
Sub getTableNameDesc(strName, strDesc, ByVal strGuid)
        GetNameDescription strName, strDesc, strGuid
End Sub


' **********************************************************
'  findColumnGuids
'
'  Finds all the Column GUIDS given a table GUID
' **********************************************************
Sub findColumnGuids(arrItems, strGuid)
    ReDim arrItems(0)       ' in case of error or not found

    Dim roTable
    Dim roColumn
    Dim iCnt

    Set roTable = rRepos.Version(strGuid)
    iCnt = 0
    For Each roColumn In roTable("IUmlType").Members
      If VerifyInterfaceSupport(roColumn, strIDbmDeployedColumn) Then
        iCnt = iCnt + 1
        CheckArraySize arrItems, iCnt
        arrItems(iCnt - 1) = GetOIDString(roColumn.VersionID)
      End If
      Set roColumn = Nothing
    Next
    ReDim Preserve arrItems(iCnt)
    Set roTable = Nothing

End Sub


' **********************************************************
'  getColumnNameDesc
'
'  Finds Column Name and Description given its GUID
' **********************************************************
Sub getColumnNameDesc(strName, strDesc, ByVal strGuid)
        GetNameDescription strName, strDesc, strGuid
End Sub


' **********************************************************
'  getColumnProps
'
'  Finds Column property values given its GUID
' **********************************************************
Sub getColumnProps(arrColDataValues, ByVal strGuid)
        ReDim arrColDataValues(0)       ' in case of error or not found
        Dim roColumn

        Set roColumn = rRepos.Version(strGuid)

        On Error Resume Next
        ReDim arrColDataValues(11)
        arrColDataValues(0) = roColumn.Name 'Name
        arrColDataValues(1) = roColumn("ISummaryInformation").ShortDescription   'Description
        arrColDataValues(2) = roColumn("ISummaryInformation").Comments  'Comments
        arrColDataValues(3) = roColumn("IUmlAttribute").Type(1).Name  'DataType
        arrColDataValues(4) = roColumn("IUmxAttribute").Length   'Length
        arrColDataValues(5) = roColumn("IUmxAttribute").NumericScale     'Scale
        arrColDataValues(6) = roColumn("IUmxAttribute").NumericPrecision 'Precision
        If roColumn("IUmxAttribute").IsNullable = 0 Then
          arrColDataValues(7) = "No"
        ElseIf roColumn("IUmxAttribute").IsNullable = 1 Then
          arrColDataValues(7) = "Yes"
        Else
            arrColDataValues(7) = ""
        End If
        arrColDataValues(8) = roColumn("IUmlMember").Type(1).Name 'Table Name
        arrColDataValues(9) = roColumn("IUmlMember").Type(1)("IUmlElement").package(1).Name 'Schema Name
        arrColDataValues(10) = roColumn("IUmlMember").Type(1).Interface("IUmlElement").package(1).Interface("IUmlElement").package(1).Name 'Database Name

        On Error GoTo 0

        Set roColumn = Nothing
End Sub


' **********************************************************
'  getTableProps
'
'  Finds Table property values given its GUID
' **********************************************************
Sub getTableProps(arrTablePropValues, ByVal strTableGuid)
        ReDim arrTablePropValues(0)     ' in case of error or not found
        Dim roTable

        Set roTable = rRepos.Version(strTableGuid)
        ReDim arrTablePropValues(5)
        arrTablePropValues(0) = roTable.Name       'Name
        arrTablePropValues(1) = roTable("ISummaryInformation").ShortDescription          'description
        arrTablePropValues(2) = roTable("ISummaryInformation").Comments          'comments
        arrTablePropValues(3) = roTable("IUmlElement").package(1).Name 'Schema Name
        arrTablePropValues(4) = roTable("IUmlElement").package(1).Interface("IUmlElement").package(1).Name 'Database Name

        Set roTable = Nothing
End Sub


' **********************************************************
'  findSrcPackageGuids
'
'  Finds all the Source Package GUIDS given a table or
'  column guid and the type which says if it is a table or
'  column
' **********************************************************
Sub findSrcPackageGuids(arrPackGuids, ByVal strGuid, ByVal strType)
        Call findPackageGuids(arrPackGuids, strGuid, strType, "source")
End Sub

' **********************************************************
'  findTgtPackageGuids
'
'  Finds all the Target Package GUIDS given a table or
'  column guid and the type which says if it is a table or
'  column
' **********************************************************
Sub findTgtPackageGuids(arrPackGuids, ByVal strGuid, ByVal strType)
        Call findPackageGuids(arrPackGuids, strGuid, strType, "target")
End Sub

' **********************************************************
'  findPackageGuids
'
'  Finds all the Package GUIDS given a table or
'  column guid and the type which says if it is a table or
'  column, source or target is passed in
' **********************************************************
Sub findPackageGuids(arrPackGuids, ByVal strGuid, ByVal strType, ByVal strDirection)
        ReDim arrPackGuids(0)   ' in case of error or not found
        Dim roTemp
        Dim roTemp2
        Dim roTemp3
        Dim iTotalItems
        Dim iNum, iCnt

        iTotalItems = 0
        If (strType = "table") Then
          FindPackages arrPackGuids, strGuid, iTotalItems, strDirection
          Set roTemp = rRepos.Version(strGuid)

 'Jason - this is the old code

          'iNum = roTemp("IUmlType").Members.Count
          'For iCnt = 1 To iNum
          '  Set roTemp2 = roTemp("IUmlType").Members(iCnt)
          '  FindPackages arrPackGuids, GetOIDString(roTemp2.VersionID), iTotalItems, strDirection
          '  Set roTemp2 = Nothing
          'Next
  'here is the new try. Keep getting automation errors on trying to get to the version

          For each roTemp2 in roTemp("IUmlType").Members
            'Set roTemp2 = roTemp3.Interface("IRepositoryObjectVersion")
            FindPackages arrPackGuids, GetOIDString(roTemp2.VersionID), iTotalItems, strDirection
            Set roTemp2 = Nothing
          Next

  'End Jason


          Set roTemp = Nothing
        Else    'column
          FindPackages arrPackGuids, strGuid, iTotalItems, strDirection
          Set roTemp = rRepos.Version(strGuid)
          iNum = roTemp("IUmlMember").Type.Count
          For iCnt = 1 To iNum
            Set roTemp2 = roTemp("IUmlMember").Type(iCnt)
            FindPackages arrPackGuids, GetOIDString(roTemp2.VersionID), iTotalItems, strDirection
            Set roTemp2 = Nothing
          Next
          Set roTemp = Nothing
        End If

        ReDim Preserve arrPackGuids(iTotalItems)

End Sub

'  this function will start at the transformableobject and go back to the package for
'  any object that supports the ITransformableObject interface. The flag determines if this is a source or target
Sub FindPackages(arrIn, ByVal strGuid, iItems, strSourceTarget)
      Dim roStart
      Dim iNumTransformSets, iCntTransformSets
      Dim roTransformSet
      Dim iNumTransform, iCntTransform
      Dim roTransform
      Dim iNumTransformTask, iCntTransformTask
      Dim roTransformTask
      Dim iNumTransformPackage, iCntTransformPackage
      Dim roTransformPackage


      Set roStart = rRepos.Version(strGuid)
      iNumTransformSets = roStart("ITfmTransformableObject").TransformSets.Count
      For iCntTransformSets = 1 To iNumTransformSets
        Set roTransformSet = roStart("ITfmTransformableObject").TransformSets(iCntTransformSets)
        If strSourceTarget = "source" Then
          iNumTransform = roTransformSet("ITfmTransformableObjectSet").SourceOf.Count
        Else
          iNumTransform = roTransformSet("ITfmTransformableObjectSet").TargetOf.Count
        End If

        For iCntTransform = 1 To iNumTransform
          If strSourceTarget = "source" Then
            Set roTransform = roTransformSet("ITfmTransformableObjectSet").SourceOf(iCntTransform)
          Else
            Set roTransform = roTransformSet("ITfmTransformableObjectSet").TargetOf(iCntTransform)
          End If

          iNumTransformTask = roTransform("IUmlMember").Type.Count

          For iCntTransformTask = 1 To iNumTransformTask
            Set roTransformTask = roTransform("IUmlMember").Type(iCntTransformTask)

            iNumTransformPackage = roTransformTask("IUmlElement").package.Count

            For iCntTransformPackage = 1 To iNumTransformPackage
              Set roTransformPackage = roTransformTask("IUmlElement").package(iCntTransformPackage)
              If VerifyInterfaceSupport(roTransformPackage, strITfmTransformationPackage) Then
                AddStrGuidToArray GetOIDString(roTransformPackage.VersionID), arrIn, iItems

              End If
              Set roTransformPackage = Nothing
            Next
            Set roTransformTask = Nothing
          Next

        Set roTransform = Nothing
        Next
        Set roTransformSet = Nothing
      Next

End Sub

'   this will add a package guid to an array, making sure there are no duplicates,
'   it will also increment the total items
Sub AddStrGuidToArray(strGuid, arrIn, iNumItems)
      Dim iCnt
      Dim bFound

        bFound = False
        For iCnt = 0 To iNumItems - 1
          If arrIn(iCnt) = strGuid Then
            bFound = True
            Exit For
          End If
        Next

        If Not bFound Then
          iNumItems = iNumItems + 1
          CheckArraySize arrIn, iNumItems
          arrIn(iNumItems - 1) = strGuid
        End If

End Sub


' **********************************************************
'  findSrcTgtGuidsSrc
'
'  Finds all the source objects for a table or column.
'  The returned array of objects contains object GUIDs and if
'  it is a table or column.  The input is a GUID and an
'  indicator if the input is a table or column.
' **********************************************************
Sub findSrcTgtGuidsSrc(arrSources, strGuid, strType, iTotalItems)
        Call findSrcTgtGuids(arrSources, strGuid, strType, "target", iTotalItems)
End Sub

' **********************************************************
'  findSrcTgtGuidsTgt
'
'  Finds all the destination objects for a table or column.
'  The returned array of objects contains object GUIDs and if
'  it is a table or column.  The input is a GUID and an
'  indicator if the input is a table or column.
' **********************************************************
Sub findSrcTgtGuidsTgt(arrTargets, strGuid, strType, iTotalItems)
        Call findSrcTgtGuids(arrTargets, strGuid, strType, "source", iTotalItems)
End Sub

' **********************************************************
'  findSrcTgtGuidsSrc
'
'  Finds all the source or target objects for a table or column.
'  The returned array of objects contains object GUIDs and if
'  it is a table or column.  The input is a GUID and an
'  indicator if the input is a table or column.
' **********************************************************
Sub findSrcTgtGuids(arrSources, strGuid, strType, strSourceTarget, iTotalItems)
        ReDim arrSources(0, 1)  ' in case of error or not found
        Dim roTemp
        Dim iNum, iCnt
        Dim roTemp2

        iTotalItems = 0
        If (strType = "table") Then
          FindSrcTgtObjs arrSources, strGuid, iTotalItems, strSourceTarget
          Set roTemp = rRepos.Version(strGuid)
          iNum = roTemp("IUmlType").Members.Count
          For iCnt = 1 To iNum
            Set roTemp2 = roTemp("IUmlType").Members(iCnt)
            FindSrcTgtObjs arrSources, GetOIDString(roTemp2.VersionID), iTotalItems, strSourceTarget
            Set roTemp2 = Nothing
          Next
          Set roTemp = Nothing
        Else    'column
          FindSrcTgtObjs arrSources, strGuid, iTotalItems, strSourceTarget
        End If
End Sub

'   this will start at transformableobject and follow the loop around to any source or target objects on the
'   other side of the transformations
Sub FindSrcTgtObjs(arrIn, strGuid, iItems, strSourceTarget)
      Dim roStart
      Dim iNumTransformSets, iCntTransformSets
      Dim roTransformSet
      Dim iNumTransform, iCntTransform
      Dim roTransform
      Dim iNumOtherTransformSet, iCntOtherTransformSet
      Dim roOtherTransformSet
      Dim iNumOtherTransformableObject, iCntOtherTransformableObject
      Dim roOtherTransformableObject


      Set roStart = rRepos.Version(strGuid)
      iNumTransformSets = roStart("ITfmTransformableObject").TransformSets.Count
      For iCntTransformSets = 1 To iNumTransformSets
        Set roTransformSet = roStart("ITfmTransformableObject").TransformSets(iCntTransformSets)
        If strSourceTarget = "source" Then
          iNumTransform = roTransformSet("ITfmTransformableObjectSet").SourceOf.Count
        Else
          iNumTransform = roTransformSet("ITfmTransformableObjectSet").TargetOf.Count
        End If

        For iCntTransform = 1 To iNumTransform
          If strSourceTarget = "source" Then
            Set roTransform = roTransformSet("ITfmTransformableObjectSet").SourceOf(iCntTransform)
          Else
            Set roTransform = roTransformSet("ITfmTransformableObjectSet").TargetOf(iCntTransform)
          End If

          If strSourceTarget = "source" Then
            iNumOtherTransformSet = roTransform("ITfmTransformation").TransformTarget.Count
          Else
            iNumOtherTransformSet = roTransform("ITfmTransformation").TransformSource.Count
          End If

          For iCntOtherTransformSet = 1 To iNumOtherTransformSet
            If strSourceTarget = "source" Then
              Set roOtherTransformSet = roTransform("ITfmTransformation").TransformTarget(iCntOtherTransformSet)
            Else
              Set roOtherTransformSet = roTransform("ITfmTransformation").TransformSource(iCntOtherTransformSet)
            End If

            iNumOtherTransformableObject = roOtherTransformSet("ITfmTransformableObjectSet").TransformObjects.Count

            For iCntOtherTransformableObject = 1 To iNumOtherTransformableObject
              Set roOtherTransformableObject = roOtherTransformSet("ITfmTransformableObjectSet").TransformObjects(iCntOtherTransformableObject)
              If VerifyInterfaceSupport(roOtherTransformableObject, strIDbmTable) Then
                AddTabGuidToSrcTgtArray GetOIDString(roOtherTransformableObject.VersionID), arrIn, iItems
              ElseIf VerifyInterfaceSupport(roOtherTransformableObject, strIDbmDeployedColumn) Then
                AddColGuidToSrcTgtArray GetOIDString(roOtherTransformableObject.VersionID), arrIn, iItems
              End If
              Set roOtherTransformableObject = Nothing
            Next
            Set roOtherTransformSet = Nothing
          Next

        Set roTransform = Nothing
        Next
        Set roTransformSet = Nothing
      Next

End Sub

'   this will add a table guid to an array, making sure there are no duplicates,
'   it will also increment the total items
Sub AddTabGuidToSrcTgtArray(strGuid, arrIn, iNumItems)
      Dim iCnt
      Dim bFound

        bFound = False
        For iCnt = 0 To iNumItems - 1
          If arrIn(iCnt, 0) = strGuid Then
            bFound = True
            Exit For
          End If
        Next

        If Not bFound Then
          iNumItems = iNumItems + 1
          CheckDim2ArraySize arrIn, iNumItems
          arrIn(iNumItems - 1, 0) = strGuid
          arrIn(iNumItems - 1, 1) = "table"
        End If

End Sub

'   this will add a column guid to an array, making sure there are no duplicates,
'   it will also increment the total items
Sub AddColGuidToSrcTgtArray(strGuid, arrIn, iNumItems)
      Dim iCnt
      Dim bFound

        bFound = False
        For iCnt = 0 To iNumItems - 1
          If arrIn(iCnt, 0) = strGuid Then
            bFound = True
            Exit For
          End If
        Next

        If Not bFound Then
          iNumItems = iNumItems + 1
          CheckDim2ArraySize arrIn, iNumItems
          arrIn(iNumItems - 1, 0) = strGuid
          arrIn(iNumItems - 1, 1) = "column"
        End If

End Sub


'   this will update the comments and description for a given GUID
Sub UpdateDescriptions(strGuid, ByVal strDesc, ByVal strComments)
        Dim roTemp

        rRepos.Transaction.Begin
        Set roTemp = rRepos.Version(strGuid)
        roTemp("ISummaryInformation").ShortDescription = strDesc
        roTemp("ISummaryInformation").Comments = strComments
        rRepos.Transaction.Commit


End Sub

' **********************************************************
'  checkdim2arraysize
'
'  verifies the array is big enough, and makes it bigger if not
'   uses the intialsize and increment constants to resize
' **********************************************************
Sub CheckDim2ArraySize(arrIn, iItems)

    If iItems > UBound(arrIn, 1) Then
      If UBound(arrIn, 1) = 0 Then
        ReDim arrIn(iInitialArraySize, 1)
      Else
        ReDim Preserve arrIn(iItems + iArrayIncrement, 1)
      End If
    End If

End Sub


Function GetOIDString(ByVal ObjectID)
        Dim strTemp

    GetOIDString = objSQLNSContext.ReposOIDToString(ObjectID)


End Function